Instructions

Remettez deux fichiers R notebook (.Rmd et .html correspondants) avec les codes et les sorties de R, et les résultats commentés. Ces fichiers doivent être construits en remplissant ce fichier-ci. Les solutions des éxercices des séances vous donnent une idée de la quantité et de la typologie des commentaires requis. Écrivez tout le code de manière qu’on puisse l’exécuter à nouveau en obtenant les mêmes résultats.

En plus, remettez un fichier .mp4 avec une présentation critique des résultats (longueur maximale: 10 minutes; 10 points). Cette partie requiert les logiciels Screencast-O-Matic et Handbrake. Pour les télécharger et les utiliser, consultez les tutoriels dans le fichier “Instructions Screencast-O-matic et HandBrake.pdf”. Vous devez réaliser une présentation où chaque membre de l’équipe intervient. Screencast-O-Matic va vous aider parce qu’il permet de fusionner facilement des vidéos créés séparément.

  • Résumez brièvement la problematique et les réponses sous forme de diapositives. Vous pouvez utiliser les sorties de R, des tableaux, des graphiques et tous les outils qui peuvent aider l’illustration des réponses. Ne pas inclure le code R.
  • Faites des commentaires critiques sur les résultats obtenus, en tenant compte du but de l’analyse.
  • Avec Screencast-O-Matic, créez une capsule vidéo où vous illustrez vos diapositives. Assurez-vous que la qualité audio ne compromette pas le discours.
  • Comprimez le fichier mp4 obtenu avec Handbrake.

Exercice 1: Vente de jus d’orange (25 points + 5 points présentation)

Introduction et description des données

Nous voulons étudier les décisions d’achat des clients, en ce qui concerne la vente de jus d’orange. Comme le bénéfice marginal est plus élevé sur la vente de jus d’orange Tropicana que sur le jus d’orange Oasis, on voudrait concevoir des stratégies pour améliorer les ventes de ce jus d’orange et augmenter le chiffre d’affaires global de la chaîne de magasins qui vendent les deux.

Le fichier JusOrange.txt contient les informations sur 1070 achats de jus d’orange Tropicana ou Oasis dans des magasins de la même chaîne. En particulier, il contient des variables sur des caractéristiques du client et du produit:

  • Purchase: variable avec catégories Oasis or Tropicana, indiquant si le client a acheté du jus d’orange Oasis or Tropicana
  • WeekofPurchase: semaine d’achat
  • StoreID: identifiant du magasin (nombre de 1 à 5)
  • PriceOasis: prix de référence (avant les rabais) du jus d’orange Oasis
  • PriceTropicana: prix de référence (avant les rabais) du jus d’orange Tropicana
  • ListPriceDiff: prix de référence du jus d’orange Tropicana moins prix de référence du jus d’orange Oasis
  • DiscOasis: rabais offert sur le jus d’orange Oasis
  • DiscTropicana: rabais offert sur le jus d’orange Tropicana
  • PctDiscOasis: pourcentage de rabais sur le jus d’orange Oasis
  • PctDiscTropicana: pourcentage de rabais sur le jus d’orange Tropicana
  • SpecialOasis: variable indicatrice de spécial de la semaine sur le jus d’orange Oasis (1: spécial, 0: sinon)
  • SpecialTropicana: variable indicatrice de spécial de la semaine sur le jus d’orange Tropicana (1: spécial, 0: sinon)
  • SalePriceOasis: prix de vente du jus d’orange Oasis
  • SalePriceTropicana: prix de vente du jus d’orange Tropicana
  • PriceDiff: prix de vente du jus d’orange Tropicana moins prix de vente du jus d’orange Oasis
  • LoyalOasis: indice de fidélité de la clientèle pour la marque Oasis (nombre entre 0 et 1)

But de l’analyse

On souhaite comprendre quelles variables affectent les ventes de jus d’orange de la marque Tropicana, sur la base desquelles les magasins peuvent concevoir des stratégies pour améliorer les ventes de jus d’orange Tropicana et, par conséquent, augmenter le chiffre d’affaires global de la chaîne de magasins. Pour faire ça, on voudrait obtenir un bon modèle pour prédire la probabilité que les clients achètent du jus d’orange Tropicana au lieu du jus d’orange Oasis.

Tâches à faire:

Tâche A. (5 points)

Effectuer une analyse exploratoire des données, afin de se faire une idée des variables qui affectent les ventes de jus d’orange de l’une des deux marques et des relations entre ces variables.

Commencer par vérifier le type de variables et par les changer si nécessaire. Puis, créer des boîtes à moustaches des variables numériques pour les deux classes correspondantes à l’achat de jus d’orange Oasis or Tropicana (variable Purchase; utiliser la même limite pour l’axe y, afin de pouvoir les comparer facilement). Pour les variables qualitatives et binaires, calculer les fréquences dans les deux classes (achats de jus d’orange Oasis ou Tropicana), en utilisant la fonction table. Enfin, créer des nuages de points (scatterplots) pour visualiser les relations entre les variables numériques, en utilisant deux couleurs différentes pour les deux classes (Oasis et Tropicana) et calculer les corrélations entre elles.

  • Quelles variables semblent influencer le choix du jus d’orange Tropicana au lieu d’Oasis? Commenter tous les résultats.
  • Est-ce qu’il y a des relations entre les variables numériques? Commenter les possibles corrélations et la colinéarité, en tenant également compte de la définition des variables.
  • Est-ce que la colinéarité pose des problèmes aux arbres de décision et aux méthodes basées sur les arbres de décision (comme par exemple les forêts aléatoires)? Expliquer.

 

# PACKAGES

packages<-function(x){
  x<-as.character(match.call()[[2]])
  if (!require(x,character.only=TRUE)){
    install.packages(pkgs=x,repos="http://cran.r-project.org")
    require(x,character.only=TRUE)
  }
}
packages(tidyverse)
packages(tree)
# GESTION DE L'AFFICHAGE DES GGPLOTS
packages(ggpubr) 
packages(randomForest)
packages(ROCR)

# On importe les données dans un dataframe et on affiche les premières lignes

jus_orange = read.csv('~/Downloads/TP2/JusOrange.txt', header = TRUE, sep = ';')
head(jus_orange)

 

Voici les données importées brutes :

Purchase WeekofPurchase StoreID PriceOasis PriceTropicana ListPriceDiff DiscOasis DiscTropicana PctDiscOasis PctDiscTropicana SpecialOasis SpecialTropicana SalePriceOasis SalePriceTropicana PriceDiff LoyalOasis
Oasis 237 1 1.75 1.99 0.24 0.00 0.0 0.000000 0.000000 0 0 1.75 1.99 0.24 0.500000
Oasis 239 1 1.75 1.99 0.24 0.00 0.3 0.000000 0.150754 0 1 1.75 1.69 -0.06 0.600000
Oasis 245 1 1.86 2.09 0.23 0.17 0.0 0.091398 0.000000 0 0 1.69 2.09 0.40 0.680000
Tropicana 227 1 1.69 1.69 0.00 0.00 0.0 0.000000 0.000000 0 0 1.69 1.69 0.00 0.400000
Oasis 228 5 1.69 1.69 0.00 0.00 0.0 0.000000 0.000000 0 0 1.69 1.69 0.00 0.956535
Oasis 230 5 1.69 1.99 0.30 0.00 0.0 0.000000 0.000000 0 1 1.69 1.99 0.30 0.965228

Nous vérifions par la suite l’état global du jeu de données :  

# TYPES DE VARIABLES ET SOMMAIRE

str(jus_orange)
'data.frame':   1070 obs. of  16 variables:
 $ Purchase          : chr  "Oasis" "Oasis" "Oasis" "Tropicana" ...
 $ WeekofPurchase    : int  237 239 245 227 228 230 232 234 235 238 ...
 $ StoreID           : int  1 1 1 1 5 5 5 5 5 5 ...
 $ PriceOasis        : num  1.75 1.75 1.86 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
 $ PriceTropicana    : num  1.99 1.99 2.09 1.69 1.69 1.99 1.99 1.99 1.99 1.99 ...
 $ ListPriceDiff     : num  0.24 0.24 0.23 0 0 0.3 0.3 0.24 0.24 0.24 ...
 $ DiscOasis         : num  0 0 0.17 0 0 0 0 0 0 0 ...
 $ DiscTropicana     : num  0 0.3 0 0 0 0 0.4 0.4 0.4 0.4 ...
 $ PctDiscOasis      : num  0 0 0.0914 0 0 ...
 $ PctDiscTropicana  : num  0 0.151 0 0 0 ...
 $ SpecialOasis      : int  0 0 0 0 0 0 1 1 0 0 ...
 $ SpecialTropicana  : int  0 1 0 0 0 1 1 0 0 0 ...
 $ SalePriceOasis    : num  1.75 1.75 1.69 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
 $ SalePriceTropicana: num  1.99 1.69 2.09 1.69 1.69 1.99 1.59 1.59 1.59 1.59 ...
 $ PriceDiff         : num  0.24 -0.06 0.4 0 0 0.3 -0.1 -0.16 -0.16 -0.16 ...
 $ LoyalOasis        : num  0.5 0.6 0.68 0.4 0.957 ...
summary(jus_orange)
   Purchase         WeekofPurchase     StoreID        PriceOasis   
 Length:1070        Min.   :227.0   Min.   :1.000   Min.   :1.690  
 Class :character   1st Qu.:240.0   1st Qu.:2.000   1st Qu.:1.790  
 Mode  :character   Median :257.0   Median :3.000   Median :1.860  
                    Mean   :254.4   Mean   :3.294   Mean   :1.867  
                    3rd Qu.:268.0   3rd Qu.:5.000   3rd Qu.:1.990  
                    Max.   :278.0   Max.   :5.000   Max.   :2.090  
 PriceTropicana  ListPriceDiff     DiscOasis       DiscTropicana   
 Min.   :1.690   Min.   :0.000   Min.   :0.00000   Min.   :0.0000  
 1st Qu.:1.990   1st Qu.:0.140   1st Qu.:0.00000   1st Qu.:0.0000  
 Median :2.090   Median :0.240   Median :0.00000   Median :0.0000  
 Mean   :2.085   Mean   :0.218   Mean   :0.05186   Mean   :0.1234  
 3rd Qu.:2.180   3rd Qu.:0.300   3rd Qu.:0.00000   3rd Qu.:0.2300  
 Max.   :2.290   Max.   :0.440   Max.   :0.50000   Max.   :0.8000  
  PctDiscOasis     PctDiscTropicana  SpecialOasis    SpecialTropicana
 Min.   :0.00000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
 Median :0.00000   Median :0.0000   Median :0.0000   Median :0.0000  
 Mean   :0.02731   Mean   :0.0593   Mean   :0.1477   Mean   :0.1617  
 3rd Qu.:0.00000   3rd Qu.:0.1127   3rd Qu.:0.0000   3rd Qu.:0.0000  
 Max.   :0.25269   Max.   :0.4020   Max.   :1.0000   Max.   :1.0000  
 SalePriceOasis  SalePriceTropicana   PriceDiff         LoyalOasis      
 Min.   :1.390   Min.   :1.190      Min.   :-0.6700   Min.   :0.000011  
 1st Qu.:1.750   1st Qu.:1.690      1st Qu.: 0.0000   1st Qu.:0.325257  
 Median :1.860   Median :2.090      Median : 0.2300   Median :0.600000  
 Mean   :1.816   Mean   :1.962      Mean   : 0.1465   Mean   :0.565782  
 3rd Qu.:1.890   3rd Qu.:2.130      3rd Qu.: 0.3200   3rd Qu.:0.850873  
 Max.   :2.090   Max.   :2.290      Max.   : 0.6400   Max.   :0.999947

 

Toutes les données sont de type numérique en dehors de la variable Purchase (qui regroupe deux classes, Oasis et Tropicana), seuls la semaine d’achat, l’identifiant du magasin et les variables binaires SpecialOasiset SpecialTropicana sont du type entier. La variabl eWeekofPurchase peut être considérée comme une variable discrète. Enfin, nous vérifions qu’il n’y ait pas de données manquantes, au nombre de 0. Enfin, la variable PriceDiff comporte des valeurs négatives.  

 

BOXPLOTS  

Nous passons la variable catégorielle et les variables binaires en facteurs, et créons les boîtes à moustaches pour toutes les variables numériques, en fonction de Purchase :  

jus_orange$Purchase = as.factor(jus_orange$Purchase)
jus_orange$SpecialOasis = ifelse(jus_orange$SpecialOasis == 1, 'Oui', 'Non')
jus_orange$SpecialTropicana = ifelse(jus_orange$SpecialTropicana == 1, 'Oui', 'Non')
jus_orange$SpecialOasis = as.factor(jus_orange$SpecialOasis)
jus_orange$SpecialTropicana = as.factor(jus_orange$SpecialTropicana)
sum(is.na(jus_orange))

# BOXPLOTS - VARIABLES NUMÉRIQUES

# par(mfrow = c(2,3))
# for (i in c(4:10,13:16)){
# boxplot(jus_orange[,i]~Purchase, data = jus_orange, main = names(jus_orange)[i], ylab = '')

# }

plots = list()

# VERSION GGPLOT

for(i in names(jus_orange[,c(4:10,13:16)])) {
  plots[[i]] = ggplot(jus_orange, aes(x = Purchase, fill = Purchase)) +
          geom_boxplot(aes_string(y = i), position = position_dodge(width = .60), show.legend = "none") +
          theme_minimal()
}
ggarrange(plots[[1]], plots[[2]], plots[[3]], plots[[4]], plots[[5]], plots[[6]], plots[[7]], plots[[8]], plots[[9]], plots[[10]], plots[[11]], ncol = 2, nrow = 3)

 

Nous remarquons plusieurs faits saillants :

  • Pour PriceOasis : les clients semblent davantage acheter la marque Tropicana lorsque le prix de la marque Oasis est bas. Au contraire, lorsque le prix de la marque Tropicana est élevé, ils n’ont pas de préférence claire.
  • Pour PriceTropicana : la majeure partie des clients achetant la marque Tropicana semblent acheter cette marque lorsque son prix est plus bas.
  • Pour ListPriceDiff : la marque Tropicana est plus chère que la marque Oasis : la différence entre les prix de référence est positive en tout temps. De plus, lorsque la différence de prix est élevée, les clients préfèrent se tourner vers la marque Oasis.
  • Pour DiscOasis, PctDiscOasis : Ces boîtes à moustaches indiquent que les clients vont très nettement profiter du rabais offert sur la marque Oasis et très peu se tourner vers la marque Tropicana.
  • Pour DiscTropicana et PctDiscTropicana : Ces boîtes à moustaches indiquent que les clients vont très nettement profiter du rabais offert sur la marque Tropicana et très peu se tourner vers la marque Oasis en retour.
  • Pour SalePriceOasis : Quand le prix du jus Oasis est élevé, les clients vont acheter la marque Tropicana.
  • Pour SalePriceTropicana : Quand le prix de la marque Oasis est élevé, les clients vont se rabattre sur la marque Oasis.
  • Pour PriceDiff : Il y a des occurences où le prix de la marque Tropicana était moins élevé que celui du jus Oasis. De manière générale, quand le prix de Tropicana est élevé, les clients vont se tourner vers la marque Oasis.
  • Pour LoyalOasis : De manière générale, les clients semblent plus fidèles à la marque Oasis, peu importe la situation.  

 

FRÉQUENCES ABSOLUES  

Nous regardons à présent les fréquences absolues pour les variables non numériques, soit Purchase, SpecialOasis et SpecialTropicana :  

# FRÉQUENCES

freq_absolues_purchase = table(jus_orange$Purchase)
freq_absolues_oasis = table(jus_orange$SpecialOasis)
freq_absolues_tropi = table(jus_orange$SpecialTropicana)

 

Var1 Freq
Oasis 653
Tropicana 417

 

Pour la marque Oasis  

Var1 Freq
Non 912
Oui 158

 

Pour la marque Tropicana  

Var1 Freq
Non 897
Oui 173

 

On remarque que les marques sont en spécial 14.77% des cas pour Oasis et 16.17% pour la marque Tropicana. On note que la marque Tropicana fait davantage de spéciaux que la marque Oasis, même si les clients semblent préférer la marque Oasis.  

 

NUAGES DE POINTS  

On regarde ensuite les scatterplots, pour les interactions entre variables numériques :  

# SCATTERPLOTS

col_jus = ifelse(jus_orange$Purchase == 'Oasis', 'lightblue', 'red')
par(mfrow = c(1,1))
plot(jus_orange[,c(4:10,13:16)], col = col_jus)

 

On remarque que les clients semblent assez bien séparés par leur fidélité à l’une ou l’autre marque de jus. La variabilité semble provenir de l’instant où l’une ou l’autre marque observe un rabais sur son prix habituel : lorsque c’est le cas, davantage de clients semblent se tourner vers la marque en rabais. La variable PriceDiff, en étant l’écart de prix, semble fortement influencée par les rabais appliqués sur l’une ou l’autre marque, de même que par le prix de vente final : en effet, ces variations dans les prix viennent réduire ou agrandir l’écart de prix entre les deux marques.  

 

CORRÉLATIONS  

# CORRELATIONS

correlations = cor(jus_orange[,c(2:10,13:16)])

 

WeekofPurchase StoreID PriceOasis PriceTropicana ListPriceDiff DiscOasis DiscTropicana PctDiscOasis PctDiscTropicana SalePriceOasis SalePriceTropicana PriceDiff LoyalOasis
WeekofPurchase 1.0000000 0.0926371 0.7043241 0.5768723 0.0530385 0.3657223 0.2423341 0.3550471 0.2235326 0.2012561 0.1017187 -0.0116097 0.1928972
StoreID 0.0926371 1.0000000 0.1341428 0.1340704 0.0403458 0.3053538 -0.0230418 0.3047074 -0.0215089 -0.1547784 0.0907973 0.1662118 0.2370803
PriceOasis 0.7043241 0.1341428 1.0000000 0.6164017 -0.1779347 0.1519000 0.1163102 0.1346007 0.0991574 0.5867158 0.2293827 -0.0963351 0.0777926
PriceTropicana 0.5768723 0.1340704 0.6164017 1.0000000 0.6651870 0.0652064 -0.0012461 0.0599635 -0.0217474 0.3849413 0.5328587 0.2925944 0.1155696
ListPriceDiff 0.0530385 0.0403458 -0.1779347 0.6651870 1.0000000 -0.0625506 -0.1118477 -0.0526986 -0.1212028 -0.0752937 0.4483953 0.4570001 0.0706593
DiscOasis 0.3657223 0.3053538 0.1519000 0.0652064 -0.0625506 1.0000000 0.0180353 0.9990225 0.0147180 -0.7112738 0.0194155 0.3936154 0.1394003
DiscTropicana 0.2423341 -0.0230418 0.1163102 -0.0012461 -0.1118477 0.0180353 1.0000000 0.0185211 0.9987932 0.0679398 -0.8468676 -0.8239080 -0.0202916
PctDiscOasis 0.3550471 0.3047074 0.1346007 0.0599635 -0.0526986 0.9990225 0.0185211 1.0000000 0.0153175 -0.7227756 0.0162162 0.3967112 0.1386839
PctDiscTropicana 0.2235326 -0.0215089 0.0991574 -0.0217474 -0.1212028 0.0147180 0.9987932 0.0153175 1.0000000 0.0584590 -0.8567490 -0.8280972 -0.0224604
SalePriceOasis 0.2012561 -0.1547784 0.5867158 0.3849413 -0.0752937 -0.7112738 0.0679398 -0.7227756 0.0584590 1.0000000 0.1472224 -0.3909995 -0.0588871
SalePriceTropicana 0.1017187 0.0907973 0.2293827 0.5328587 0.4483953 0.0194155 -0.8468676 0.0162162 -0.8567490 0.1472224 1.0000000 0.8527979 0.0786313
PriceDiff -0.0116097 0.1662118 -0.0963351 0.2925944 0.4570001 0.3936154 -0.8239080 0.3967112 -0.8280972 -0.3909995 0.8527979 1.0000000 0.1042608
LoyalOasis 0.1928972 0.2370803 0.0777926 0.1155696 0.0706593 0.1394003 -0.0202916 0.1386839 -0.0224604 -0.0588871 0.0786313 0.1042608 1.0000000

 

L’analyse des corrélations montre que les prix de référence des jus sont fortement corrélés à la semaine d’achat : les prix de référence augmentent en moyenne avec les semaines. Cela pourrait être dû à l’augmentation des coûts de production, à l’ajustement des prix en fonction de l’inflation, etc…  

Les rabais et les pourcentages de rabais sur les deux marques sont plus ou moins corrélés à la semaine d’achat. Les très fortes corrélations se retrouvent entre les pourcentages de rabais et le rabais en dollars en tant que tel, ce qui est normal, mais on observe également que le prix en rabais du jus Tropicana est fortement corrélé à l’écart de prix PriceDiff observé entre les deux marques.  

Les corrélations entre les variables de rabais et les prix de vente sont négatives : quand le rabais augmente, le prix de vente diminue. Il semblerait enfin que le magasin joue un léger rôle dans la fidélité des clients pour la marque Oasis.  

Tâche B. (8 points)

Créer un ensemble d’entraînement contenant un échantillon aléatoire de 750 observations du dataset, et un ensemble de test contenant les observations restantes. Utiliser le “seed” 2021.

Ajuster un arbre de classement sur les données d’entraînement, pour prédire si un client achète du jus d’orange Oasis ou Tropicana en utilisant toutes les autres variables comme prédicteurs. Utiliser comme critère de séparation l’entropie, avec argument mindev = 0.005. Regarder les résultats et créer le graphique de l’arbre.

  • Quelle est la taille de l’arbre? Quelle est l’erreur de classement sur l’échantillon d’entraînement? Quelles variables sont utilisées?
  • Commenter la bonté et les characteristiques de l’arbre (en se basant sur les données d’entraînement).

Ensuite, appliquer l’élagage sur l’arbre que vous venez de créer, en utilisant la 10-validation croisée et le taux d’erreur de classification pour choisir le meilleur arbre. Utiliser le “seed” 28. Produire un graphique du taux d’erreur de classification en fonction de la taille des sous-arbres et obtenir le sous-arbre de la taille correspondante au plus petit taux d’erreur en validation croisée. Enfin, regarder les résultats et créer le graphique de l’arbre élagué (pour mieux lire les régles et les étiquettes des feuilles, il peut être utile d’utiliser l’argument cex = 0.7).

  • Quelle est la taille de l’arbre élagué choisi? Quelle est l’erreur de classement sur l’échantillon d’entraînement? Quelles variables sont utilisées?
  • Commenter la bonté et les characteristiques de l’arbre élagué (en se basant sur les données d’entraînement) et le comparer avec l’arbre non élagué.
  • Quelle est la variable la plus importante dans l’arbre élagué? Expliquer.

 

On crée ici un ensemble d’entraînement de 750 observations, choisies aléatoirement. L’ensemble de test contient toutes les autres observations, soit 320 observations.  

set.seed(2021)
train_index = sample(x = nrow(jus_orange), size = 750, replace = FALSE)

jus_orange_train = jus_orange[train_index,]
jus_orange_test = jus_orange[-train_index,]

 

MODÈLE INITIAL  

tree_large_train = tree(Purchase ~ ., data = jus_orange_train, 
                                control = tree.control(nobs = nrow(jus_orange_train), mindev = 0.005))
summary(tree_large_train)

Classification tree:
tree(formula = Purchase ~ ., data = jus_orange_train, control = tree.control(nobs = nrow(jus_orange_train), 
    mindev = 0.005))
Variables actually used in tree construction:
[1] "LoyalOasis"     "PriceDiff"      "WeekofPurchase" "StoreID"       
[5] "ListPriceDiff"  "DiscOasis"      "SpecialOasis"   "PriceOasis"    
Number of terminal nodes:  20 
Residual mean deviance:  0.6189 = 451.8 / 730 
Misclassification error rate: 0.136 = 102 / 750

 

La taille de l’arbre initial est de 20 feuilles. Les variables utilisées sont LoyalOasis, PriceDiff, SpecialOasis, SalePriceTropicana, ListPriceDiff, DiscOasis, PriceOasis et PctDiscOasis. SpecialOasis est la seule des deux variables binaires à être utilisée. L’erreur de classification est de 13.6%, ce qui semble faible. Nous affichons ci-dessous l’arbre et calculons l’erreur totale, ainsi que pour chaque classe :  

plot(tree_large_train)
text(tree_large_train, cex = 0.7)

 

On peut également calculer les erreurs de classement selon la marque et l’erreur totale :  

tree_large_pred_test = predict(tree_large_train, jus_orange_test, type = "class")
head(tree_large_pred_test)
[1] Oasis Oasis Oasis Oasis Oasis Oasis
Levels: Oasis Tropicana
err_tot_tree_large = mean(tree_large_pred_test != jus_orange_test$Purchase)
err_O_tree_large = mean( (tree_large_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_tree_large = mean( (tree_large_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_tree_large = c(err_tot_tree_large, err_O_tree_large, err_T_tree_large)
errors = cbind(err_tree_large)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
errors
          err_tree_large
totale         0.2312500
Oasis          0.2463054
Tropicana      0.2051282

 

On remarque que l’erreur totale est d’environ 23.13%. Le modèle semble mieux classer les achats de jus Tropicana que ceux de la marque Oasis. Nous pouvons réajuster le modèle en élaguant l’arbre :  

 

ÉLAGAGE DE L’ARBRE  

set.seed(28)
cv_tree_large_train = cv.tree(tree_large_train, K = 10, FUN = prune.misclass)
cv_tree_large_train
$size
[1] 20 13  9  5  2  1

$dev
[1] 137 138 137 140 140 300

$k
[1]   -Inf   0.00   0.75   2.00   6.00 169.00

$method
[1] "misclass"

attr(,"class")
[1] "prune"         "tree.sequence"
plot(cv_tree_large_train)

 

D’après le graphique ci-dessus, les erreurs de classement sont au plus faible à partir de 9 feuilles. Nous ajustons le modèle avec comme argument best = 9.  

tree_large_pruned = prune.tree(tree_large_train, best = 9, method = "misclass")
summary(tree_large_pruned)

Classification tree:
snip.tree(tree = tree_large_train, nodes = c(7L, 24L, 47L, 13L
))
Variables actually used in tree construction:
[1] "LoyalOasis"     "PriceDiff"      "WeekofPurchase" "ListPriceDiff" 
[5] "DiscOasis"     
Number of terminal nodes:  9 
Residual mean deviance:  0.7043 = 521.9 / 741 
Misclassification error rate: 0.14 = 105 / 750 
plot(tree_large_pruned)
text(tree_large_pruned, cex = 0.7)

 

L’arbre élagué comporte 9 feuilles au total. Ici, seulement cinq variables sont utilisées : on retrouve LoyalOasis, ListPriceDiff, PriceDiff, WeekofPurchase et DiscOasis. Dans ce modèle comme dans le précédent, la fidélité des clients à la marque Oasis semble jouer un rôle important, de même que le rabais appliqué au prix ou la différence de prix entre les marques Oasis et Tropicana. Cependant, l’arbre élagué semble moins précis que l’arbre entier : son erreur de classification est de 14%, soit environ 0.4 points de plus.  

 

COMPARAISON DES DEUX MODÈLES  

tree_large_pruned_pred_test = predict(tree_large_pruned, jus_orange_test, type = "class")

err_tot_tree_large_pruned = mean(tree_large_pruned_pred_test != jus_orange_test$Purchase)
err_O_tree_large_pruned = mean( (tree_large_pruned_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_tree_large_pruned = mean( (tree_large_pruned_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_tree_large_pruned = c(err_tot_tree_large_pruned, err_O_tree_large_pruned, err_T_tree_large_pruned)

errors = cbind(err_tree_large, err_tree_large_pruned)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
colnames(errors) = c('default', 'large pruned')
errors
            default large pruned
totale    0.2312500    0.2343750
Oasis     0.2463054    0.2463054
Tropicana 0.2051282    0.2136752

 

D’après la matrice, les taux d’erreur totales sont similaires entre les deux modèles, néanmoins, il est à noter que l’arbre élagué performe moins bien sur le classement de la marque Tropicana et mieux sur la marque Oasis. On peut également tracer les courbes ROC et retrouver leurs aires sous la courbe :  

 

COURBES ROC  

tree_large_prob_test = predict(tree_large_train, jus_orange_test)[,'Tropicana']
tree_large_pruned_prob_test = predict(tree_large_pruned, jus_orange_test)[,'Tropicana']

pred_tree = prediction(tree_large_prob_test, jus_orange_test$Purchase)
roc_tree = performance(pred_tree, measure = "tpr", x.measure = "fpr")

pred_tree_large_pruned = prediction(tree_large_pruned_prob_test, jus_orange_test$Purchase)
roc_tree_large_pruned = performance(pred_tree_large_pruned, measure = "tpr", x.measure = "fpr")
auc = performance(pred_tree, measure = 'auc')
auc_pruned = performance(pred_tree_large_pruned, measure = 'auc')

plot(roc_tree, col = 'red')
plot(roc_tree_large_pruned, col = 'green', add = TRUE)

abline(0, 1, col = 'darkgray', lty = 2)
legend('bottomright', legend = c('Default tree', 'Large tree pruned'), col = c('red', 'green'), lty = 1)

 

On voit que le modèle d’arbre élagué performe presque aussi bien que l’arbre initial, les valeurs AUC sont respectivement de 0.8350385 et 0.8352911. Le modèle initial est meilleur pour classer des petites valeurs de faux positifs, tandis que le modèle élagué performe mieux sur les grandes valeurs (la courbe verte se situe au-dessus de la courbe rouge).  

Tâche C. (7 points)

Utiliser une forêt aléatoire avec 1000 arbres sur les données d’entraînement (avec nombre de prédicteurs considerés à chaque noeud par défaut) pour prédire si un client achète du jus d’orange Oasis ou Tropicana en utilisant toutes les autres variables comme prédicteurs. Utiliser le “seed” 5. Régarder les résultats et produire un graphique de l’importance des variables.

  • Combien de prédicteurs ont été utilisés à chaque scission? Quels prédicteurs sont les plus importants dans le modèle?
  • Commenter les résultats de classement (erreurs et matrice de confusion) de la méthode avec 1000 arbres sur les données out-of-bag.

Enfin, comparer les erreurs de classement (total et pour chaque classe) sur les données out-of-bag, en fonction du nombre d’arbres de 1 à 1000. Quel nombre d’arbres donne le meilleur résultat? Expliquer.  

set.seed(5)

bag_train = randomForest(x = jus_orange_train[,-1], y = jus_orange_train$Purchase,
                         mtry = ncol(jus_orange_train), ntree = 1000, importance = TRUE,
                         xtest = jus_orange_test[,-1], ytest = jus_orange_test$Purchase)

bag_train

Call:
 randomForest(x = jus_orange_train[, -1], y = jus_orange_train$Purchase,      xtest = jus_orange_test[, -1], ytest = jus_orange_test$Purchase,      ntree = 1000, mtry = ncol(jus_orange_train), importance = TRUE) 
               Type of random forest: classification
                     Number of trees: 1000
No. of variables tried at each split: 15

        OOB estimate of  error rate: 16.67%
Confusion matrix:
          Oasis Tropicana class.error
Oasis       385        65   0.1444444
Tropicana    60       240   0.2000000
                Test set error rate: 21.88%
Confusion matrix:
          Oasis Tropicana class.error
Oasis       162        41   0.2019704
Tropicana    29        88   0.2478632

Les résultats indiquent que 15 variables ont été testées à chaque noeud. Le modèle fait peu d’erreurs out-of-bag (16.67%), légèrement plus sur les données de test (21.88%). Les classes de jus sont mieux prédites dans les données out-of-bag que dans les données de test.

importance(bag_train)
                         Oasis  Tropicana MeanDecreaseAccuracy MeanDecreaseGini
WeekofPurchase      14.3853481  21.617122            27.117014        36.702404
StoreID             18.6509177  28.130955            34.056552        15.252514
PriceOasis           9.2452202  11.049554            15.287426         4.352333
PriceTropicana       7.3880328   8.992980            12.177327         3.703322
ListPriceDiff       25.3959414  19.419891            33.781596        19.747054
DiscOasis            0.5029303   7.291513             6.413207         2.572663
DiscTropicana        8.4104234   8.144637            12.591643         2.756509
PctDiscOasis         2.4332097   8.754542             8.493090         2.669697
PctDiscTropicana     7.8289451   9.798256            13.353281         3.226769
SpecialOasis        14.3263577  10.126104            18.615687         3.989358
SpecialTropicana    -5.3008905   6.198597             1.852797         1.640817
SalePriceOasis       5.4634902  10.850488            12.441891         5.622810
SalePriceTropicana   6.3088319  21.788088            22.039528         8.637419
PriceDiff           18.1981730  30.236130            37.835756        24.138795
LoyalOasis         132.2504004 153.521044           190.821165       220.240106
varImpPlot(bag_train, main = 'Bagging - Jus Orange')

 

Il semblerait que l’indice de fidélité soit la variable la plus importante du modèle, suivi par la différence de prix entre les deux marques et enfin du magasin où le jus a été acheté. Pour ce qui est de la semaine d’achat, son importance dépend du critère d’évaluation du modèle. Au contraire, les clients semblent peu réceptifs au fait que le jus de marque Tropicana soit en spécial ou non.

Matrice des probabilités prédites pour chaque classe pour les données de test :  

Oasis Tropicana
2 0.753 0.247
3 0.743 0.257
5 0.994 0.006
6 0.989 0.011
9 0.994 0.006
11 0.997 0.003

 

# CHUNK FACULTATIF : ON REPORTE LA COURBE ROC PLUS TARD AVEC LA COMPARAISON

rf_prob_test = bag_train$test$votes[,'Tropicana']

pred_rf = prediction(rf_prob_test, jus_orange_test$Purchase)
roc_rf = performance(pred_rf, measure = "tpr", x.measure = "fpr")
auc_rf = performance(pred_rf, measure = "auc")

plot(roc_rf, col = 'red')

abline(0, 1, col = 'darkgray', lty = 2)

auc = performance(pred_tree, measure = 'auc')
auc_rf@y.values

 

Si on observe la courbe ROC du modèle, on se rend compte que celui-ci performe très bien, avec une AUC de 0.8493748.  

ntree_max = bag_train$ntree
rf_err_tot_oob = bag_train$err.rate[, 1]
rf_err_O_oob = bag_train$err.rate[, 2]
rf_err_T_oob = bag_train$err.rate[, 3]

par( mfrow = c(1,3) )
plot(1:ntree_max, rf_err_tot_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Total error rate', main = 'Out-of-bag results')
plot(1:ntree_max, rf_err_O_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Error rate Oasis', main = 'Out-of-bag results')
plot(1:ntree_max, rf_err_T_oob, type = 'b', col = 'blue', xlab = 'Number of trees', ylab = 'Error rate Tropicana', main = 'Out-of-bag results')

  Il semblerait que le taux d’erreur total soit au plus bas avec un nombre maximal d’arbres. Pour la marque Oasis, le meilleur résultat se stabilise aux alentours de 600-800 arbres, tandis que pour la marque Tropicana, le taux d’erreur OOB est au plus faible entre 800 et 1000 arbres.  

Tâche D. (5 points)

Comparer les résultats de l’arbre élagué obtenu au point B avec les résultats de la forêt aléatoire avec le nombre d’arbres choisi au point C. Utiliser le “seed” 5 pour ajuster à nouveau la forêt aléatoire, si nécessaire. En particulier, calculer les erreurs de classement (total et pour chaque classe) sur les données de test, créer les courbes ROC et calculer l’aire sous la courbe ROC correspondante en utilisant les données de test pour les deux méthodes. Commenter tous les résultats et choisir le modèle le meilleur entre les deux.

Noter que, pour la forêt aléatoire, les classes prédites pour les données de test sont dans la sortie de randomForest, à l’intérieur de la liste test, dans le vecteur appelé predicted. Les probabilités prédites pour chaque classe pour les données de test sont aussi dans la sortie de randomForest, à l’intérieur de la liste test, dans la matrice appelée votes.

 

rf_pred_test = bag_train$test$predicted
err_tot_rf = mean(rf_pred_test != jus_orange_test$Purchase)
err_O_rf = mean( (rf_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Oasis'] )
err_T_rf = mean( (rf_pred_test != jus_orange_test$Purchase)[jus_orange_test$Purchase == 'Tropicana'] )
err_rf = c(err_tot_rf, err_O_rf, err_O_rf)

errors = cbind(err_tree_large, err_tree_large_pruned, err_rf)
row.names(errors) = c('totale', 'Oasis', 'Tropicana')
colnames(errors) = c('default', 'large pruned', 'random forest')
errors
            default large pruned random forest
totale    0.2312500    0.2343750     0.2187500
Oasis     0.2463054    0.2463054     0.2019704
Tropicana 0.2051282    0.2136752     0.2019704
plot(roc_tree_large_pruned, col = 'green')
plot(roc_rf, col = 'blue', add = TRUE)

abline(0, 1, col = 'darkgray', lty = 2)
legend('bottomright', legend = c('Large tree pruned', 'Random Forest'), col = c('green', 'blue'), lty = 1)

 

Au niveau des taux d’erreurs, il semblerait que le fait d’élaguer augmente légèrement l’erreur totale. La différence se retrouve dans les erreurs par marque où l’ajustement semble avoir diminué l’erreur de classement pour le jus d’orange Tropicana de 4.17%, tandis que le taux d’erreur pour Oasis augmente de 0%. Les taux d’erreur pour les deux marques sont égaux pour le modèle de forêt aléatoire. Le modèle de forêt aléatoire est celui qui possède le taux d’erreur le plus bas dans les trois catégories. Pour les courbes ROC, les aires sous la courbe sont respectivement de 0.8350385` et de 0.8493748 pour l’arbre élagué et la forêt aléatoire. Le modèle aléatoire performe mieux que le modèle ajusté par un élagage.  

 

Exercice 2: Taux d’intérêt canadiens en temps de COVID-19 (15 points + 5 points présentation)

Introduction et description des données

Le fichier yield_curves.csv contient les rentabilités à l’échéance d’obligations à coupon zéro d’une durée allant de 3 mois à 30 ans, sur une base trimestrielle (120 échéances au total), pour chaque jour de 22 mars 2019 à 30 novembre 2020. Les courbes des rentabilités quotidiennes ont été générées à partir des données des prix des obligations du gouvernement canadien. Ces données peuvent être téléchargées à partir du site de la Banque du Canada. En particulier, le dataset contient les variables suivantes:

  • Date: date en format année/mois/jour
  • Yield3m, Yield6m, …, Yield360m: rentabilité à échéance 3 mois, 6 mois, …, 360 mois (30 ans); 120 variables au total

La courbe des rentabilités (ou structure par termes des taux d’intérêt) représente les rentabilités des obligations d’État en fonction de leur échéance.

But de l’analyse

Le but de l’analyse est de comprendre l’évolution des facteurs de la courbe des rentabilités pendant la période de la COVID-19, afin de clarifier les effets de la pandémie et des politiques monétaires connexes sur les marchés obligataires.

À la suite du début de l’épidémie de COVID-19, la Banque du Canada a annoncé plusieurs mesures pour réduire la panique sur les marchés, parmi lesquelles on a une réduction considérable du taux cible du financement à un jour de 1,75% à 0,25% en mars 2020. Nous souhaitons évaluer les effets des ces interventions de la Banque du Canada sur la structure par termes des taux d’intérêt, en comparant les courbes des rentabilités avant et au cours de la première vague de COVID-19.

En particulier, on veut comparer les trois premières composantes principales des courbes des rentabilités. Ces composantes sont interprétées comme niveau, pente et courbure dans Litterman & Scheinkman (1991). Elles correspondent à des mouvements de la courbe des rentabilités: translation des taux d’intérêt vers le haut ou vers le bas (niveau), incréments à court terme et non à long terme ou vice versa (pente), changements à court et long terme dans une direction et changements aux termes moyens dans la direction opposée (courbure).

Tâches à faire:

Tâche A. (4 points)

Créer deux ensembles des données basés sur les dates: période pré-COVID-19 du 22 mars 2019 au 27 février 2020 et période COVID-19 à partir du 27 mars 2020. Noter qu’on enlève les données du 28 février 2020 au 26 mars 2020, comme c’est la période des interventions de la Banque du Canada et la volatilité est très élevée.

Pour chacune des deux périodes, calculer les moyennes des rentabilités à chaque échéance, c’est-à-dire pour chacune des 120 variables Yield3m, Yield6m, …, Yield360m. Créer un graphique de ces moyennes en fonction de l’échéance et le commenter. Ce graphique constitue une sorte de structure par termes des moyennes des taux. En particulier, commenter les différences entre les deux périodes (rentabilités plus ou moins élevées, forme de la courbe, différences entre les rentabilités à différentes échéances).  

# On importe les données dans un dataframe et on affiche les premières lignes

yd_curves = read.csv('~/Downloads/TP2/yield_curves.csv', header = TRUE, sep = ',')
head(yd_curves)

str(yd_curves)
summary(yd_curves)

 

Date Yield3m Yield6m Yield9m Yield12m Yield15m Yield18m Yield21m Yield24m Yield27m Yield30m Yield33m Yield36m Yield39m Yield42m Yield45m Yield48m Yield51m Yield54m Yield57m Yield60m Yield63m Yield66m Yield69m Yield72m Yield75m Yield78m Yield81m Yield84m Yield87m Yield90m Yield93m Yield96m Yield99m Yield102m Yield105m Yield108m Yield111m Yield114m Yield117m Yield120m Yield123m Yield126m Yield129m Yield132m Yield135m Yield138m Yield141m Yield144m Yield147m Yield150m Yield153m Yield156m Yield159m Yield162m Yield165m Yield168m Yield171m Yield174m Yield177m Yield180m Yield183m Yield186m Yield189m Yield192m Yield195m Yield198m Yield201m Yield204m Yield207m Yield210m Yield213m Yield216m Yield219m Yield222m Yield225m Yield228m Yield231m Yield234m Yield237m Yield240m Yield243m Yield246m Yield249m Yield252m Yield255m Yield258m Yield261m Yield264m Yield267m Yield270m Yield273m Yield276m Yield279m Yield282m Yield285m Yield288m Yield291m Yield294m Yield297m Yield300m Yield303m Yield306m Yield309m Yield312m Yield315m Yield318m Yield321m Yield324m Yield327m Yield330m Yield333m Yield336m Yield339m Yield342m Yield345m Yield348m Yield351m Yield354m Yield357m Yield360m
2019-03-22 1.66345 1.66518 1.65846 1.65175 1.57151 1.55843 1.54727 1.53774 1.52966 1.52287 1.51727 1.51275 1.50924 1.50665 1.50494 1.50403 1.50389 1.50446 1.50570 1.50758 1.51005 1.51308 1.51664 1.52070 1.52523 1.53021 1.53560 1.54139 1.54754 1.55404 1.56086 1.56797 1.57537 1.58302 1.59090 1.59900 1.60729 1.61575 1.62437 1.63312 1.64198 1.65094 1.65998 1.66908 1.67822 1.68738 1.69656 1.70573 1.71487 1.72397 1.73302 1.74200 1.75090 1.75970 1.76839 1.77696 1.78540 1.79369 1.80183 1.80980 1.81759 1.82520 1.83262 1.83983 1.84684 1.85363 1.86020 1.86655 1.87267 1.87855 1.88419 1.88959 1.89475 1.89966 1.90432 1.90874 1.91291 1.91683 1.92051 1.92394 1.92713 1.93008 1.93280 1.93528 1.93753 1.93955 1.94135 1.94294 1.94432 1.94549 1.94646 1.94724 1.94783 1.94824 1.94848 1.94856 1.94847 1.94823 1.94785 1.94733 1.94669 1.94592 1.94503 1.94405 1.94296 1.94178 1.94052 1.93918 1.93778 1.93631 1.93479 1.93323 1.93162 1.92998 1.92831 1.92662 1.92492 1.92321 1.92150 1.91979
2019-03-25 1.66414 1.66833 1.65400 1.63968 1.52493 1.50845 1.49511 1.48434 1.47571 1.46890 1.46368 1.45983 1.45719 1.45562 1.45499 1.45519 1.45616 1.45779 1.46005 1.46285 1.46617 1.46995 1.47417 1.47878 1.48377 1.48910 1.49476 1.50073 1.50698 1.51351 1.52029 1.52732 1.53458 1.54205 1.54973 1.55759 1.56563 1.57383 1.58218 1.59067 1.59928 1.60799 1.61680 1.62569 1.63465 1.64365 1.65270 1.66176 1.67083 1.67989 1.68892 1.69792 1.70687 1.71575 1.72455 1.73325 1.74185 1.75033 1.75867 1.76686 1.77490 1.78276 1.79044 1.79794 1.80523 1.81231 1.81917 1.82581 1.83221 1.83837 1.84428 1.84994 1.85535 1.86050 1.86538 1.87000 1.87435 1.87844 1.88226 1.88581 1.88909 1.89211 1.89487 1.89738 1.89962 1.90162 1.90337 1.90489 1.90616 1.90722 1.90805 1.90867 1.90908 1.90930 1.90933 1.90917 1.90885 1.90837 1.90773 1.90695 1.90604 1.90500 1.90385 1.90260 1.90125 1.89982 1.89831 1.89674 1.89511 1.89344 1.89173 1.88999 1.88823 1.88647 1.88470 1.88293 1.88118 1.87945 1.87774 1.87607
2019-03-26 1.66418 1.66923 1.66000 1.65076 1.54382 1.52736 1.51374 1.50249 1.49329 1.48587 1.48003 1.47559 1.47238 1.47029 1.46920 1.46901 1.46964 1.47101 1.47305 1.47571 1.47893 1.48268 1.48690 1.49156 1.49664 1.50209 1.50790 1.51404 1.52048 1.52722 1.53421 1.54146 1.54893 1.55662 1.56450 1.57255 1.58078 1.58914 1.59764 1.60625 1.61497 1.62376 1.63263 1.64155 1.65051 1.65950 1.66849 1.67748 1.68645 1.69539 1.70427 1.71310 1.72185 1.73051 1.73906 1.74751 1.75582 1.76400 1.77203 1.77990 1.78759 1.79511 1.80243 1.80955 1.81647 1.82317 1.82965 1.83591 1.84192 1.84770 1.85324 1.85853 1.86356 1.86835 1.87288 1.87716 1.88117 1.88494 1.88844 1.89170 1.89470 1.89745 1.89996 1.90222 1.90424 1.90603 1.90760 1.90893 1.91006 1.91097 1.91167 1.91218 1.91250 1.91264 1.91261 1.91241 1.91205 1.91155 1.91091 1.91013 1.90924 1.90823 1.90712 1.90591 1.90462 1.90325 1.90182 1.90032 1.89878 1.89719 1.89557 1.89393 1.89226 1.89059 1.88892 1.88725 1.88559 1.88394 1.88233 1.88074
2019-03-27 1.66347 1.66234 1.64544 1.62854 1.51398 1.49313 1.47639 1.46310 1.45273 1.44484 1.43907 1.43511 1.43270 1.43161 1.43164 1.43264 1.43446 1.43699 1.44013 1.44380 1.44792 1.45245 1.45733 1.46253 1.46801 1.47376 1.47974 1.48596 1.49239 1.49902 1.50584 1.51286 1.52005 1.52742 1.53497 1.54268 1.55054 1.55857 1.56673 1.57504 1.58348 1.59204 1.60072 1.60949 1.61836 1.62730 1.63632 1.64538 1.65449 1.66361 1.67275 1.68189 1.69100 1.70008 1.70910 1.71806 1.72693 1.73571 1.74437 1.75290 1.76128 1.76951 1.77756 1.78542 1.79309 1.80054 1.80777 1.81476 1.82151 1.82800 1.83423 1.84020 1.84588 1.85128 1.85639 1.86121 1.86574 1.86996 1.87389 1.87752 1.88085 1.88389 1.88663 1.88908 1.89125 1.89313 1.89474 1.89608 1.89715 1.89798 1.89856 1.89890 1.89901 1.89891 1.89861 1.89811 1.89743 1.89658 1.89557 1.89442 1.89313 1.89172 1.89020 1.88859 1.88690 1.88514 1.88332 1.88146 1.87956 1.87765 1.87573 1.87381 1.87190 1.87002 1.86818 1.86638 1.86464 1.86296 1.86135 1.85982
2019-03-28 1.66763 1.66452 1.65780 1.65108 1.53611 1.51677 1.50107 1.48843 1.47840 1.47061 1.46475 1.46053 1.45773 1.45614 1.45561 1.45598 1.45714 1.45898 1.46141 1.46437 1.46780 1.47164 1.47586 1.48042 1.48529 1.49046 1.49591 1.50162 1.50758 1.51378 1.52022 1.52688 1.53375 1.54084 1.54814 1.55563 1.56331 1.57118 1.57922 1.58742 1.59578 1.60429 1.61293 1.62169 1.63056 1.63952 1.64856 1.65767 1.66682 1.67602 1.68522 1.69443 1.70363 1.71279 1.72190 1.73094 1.73991 1.74877 1.75752 1.76613 1.77460 1.78291 1.79104 1.79898 1.80671 1.81423 1.82152 1.82857 1.83537 1.84191 1.84818 1.85418 1.85989 1.86531 1.87044 1.87528 1.87981 1.88404 1.88796 1.89158 1.89490 1.89792 1.90064 1.90306 1.90520 1.90705 1.90862 1.90991 1.91094 1.91172 1.91225 1.91253 1.91260 1.91244 1.91207 1.91151 1.91077 1.90986 1.90878 1.90756 1.90621 1.90473 1.90315 1.90147 1.89971 1.89788 1.89599 1.89406 1.89210 1.89012 1.88813 1.88614 1.88417 1.88223 1.88032 1.87846 1.87665 1.87491 1.87324 1.87165
2019-03-29 1.66527 1.67826 1.68686 1.69546 1.59590 1.57857 1.56416 1.55240 1.54302 1.53574 1.53030 1.52645 1.52400 1.52276 1.52257 1.52329 1.52480 1.52699 1.52979 1.53310 1.53688 1.54107 1.54563 1.55051 1.55569 1.56114 1.56685 1.57278 1.57894 1.58531 1.59188 1.59863 1.60556 1.61267 1.61994 1.62737 1.63495 1.64267 1.65053 1.65852 1.66662 1.67483 1.68314 1.69153 1.70000 1.70853 1.71712 1.72574 1.73439 1.74304 1.75170 1.76033 1.76893 1.77749 1.78599 1.79441 1.80274 1.81096 1.81906 1.82704 1.83486 1.84253 1.85002 1.85733 1.86444 1.87135 1.87804 1.88450 1.89073 1.89671 1.90244 1.90791 1.91311 1.91805 1.92271 1.92710 1.93121 1.93504 1.93858 1.94185 1.94483 1.94754 1.94997 1.95213 1.95402 1.95564 1.95701 1.95813 1.95900 1.95964 1.96004 1.96023 1.96021 1.95998 1.95957 1.95897 1.95821 1.95728 1.95621 1.95500 1.95367 1.95223 1.95068 1.94905 1.94734 1.94556 1.94373 1.94186 1.93996 1.93804 1.93611 1.93418 1.93227 1.93037 1.92851 1.92669 1.92492 1.92321 1.92156 1.91999

 

SÉPARATION DES SETS DE PÉRIODES PRÉCOVID ET COVID, CALCUL DES TAUX MOYENS ET GRAPHIQUE  

# AGREGATION

yd_cv_average = matrix(NA, 120, 4, byrow = TRUE) %>%
  as.data.frame()

  for (i in 2:ncol(yd_curves)) {
    yd_cv_average[i-1,1] = colnames(yd_curves)[i]
    yd_cv_average[i-1,2] = mean(yd_curves[1:233,i])
    yd_cv_average[i-1,3] = mean(yd_curves[234:nrow(yd_curves),i])
    yd_cv_average[i-1,4] = seq(3,360,3)[i-1]
  }

# ATTRIBUTION DES NOMS DE COLONNES

colnames(yd_cv_average) = c("Yield", "precovid", "covid", "echeance")

# GRAPHIQUE

ggplot(yd_cv_average, aes(x = echeance)) +
  geom_jitter(aes(y = precovid, col = 'blue')) +
  geom_jitter(aes(y = covid, col = 'red')) +
  scale_color_discrete(labels = c("Période pré-Covid", "Période Covid")) +
  theme_minimal() +
  ylim(c(0,2)) +
  labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, selon la période") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

 

Nous constatons qu’après intervention de la banque centrale, les taux à court terme et à long terme ont diminué. Cependant, les taux moyens à CT ont baissé davantage que les taux moyens à LT, ce qui fait que la structure à terme des taux est devenue croissante avec des taux à CT plus bas que les taux à LT. C’est ce que l’on vise.

Cette baisse s’explique par le fait que, comme les banques vont se financer à des taux interbancaires plus bas au niveau de la banque centrale, elles vont pouvoir prêter aux entreprises à des taux plus bas. Aussi, lorsqu’il y a moins de risque, les investisseurs demandent moins de rendement, ce qui va faire diminuer le niveau des taux de rendement de façon générale, aussi bien pour les taux à CT que pour les taux à LT, et permettra une relance de l’économie.

Les taux à court terme diminuent davantage que les taux à LT. Ainsi, l’intervention gouvernementale à fait en sorte que les différentes parties sur le marché soient rassurées.Ce regain de confiance sur l’avenir a poussé les investisseurs à investir de nouveau sur le long terme et exiger plus de rendement, car ils se privent de leur argent plus longtemps. Pour la première courbe, en rouge, la structure est presque plate (l’amplitude de la courbe est faible), dans le sens où les taux à CT étaient presque équivalents aux taux à LT.  

Tâche B. (8 points)

Effectuer une analyse en composantes principales pour les rentabilités à chaque échéance dans les deux périodes. Ne pas mettre à l’échelle les 120 variables, puisq’elles ont déjà toutes la même échelle (elles sont des rendements en pourcentage). Considérer seulement les premières trois composantes (qui peuvent être interprétées comme niveau, pente et courbure).

Pour chaque période: * Créer un graphique de la proportion de variance expliquée par chacune des premières trois composantes et un graphique de la variance cumulative expliquée par les premières 1, 2 et 3 composantes. Commenter les résultats. * Visualiser et interpreter les chargements (“loadings”) pour les premières trois composantes (à quoi corresponds grossièrement chaque composante?)

 

MODÈLE EN COMPOSANTES PRINCIPALES  

Note : les rangs 1 à 233 concernent les observations pré-Covid. Les rangs 234 jusqu’à la fin concernent les observations en période Covid.  

pc_yield_precovid = prcomp(yd_curves[1:233,2:121], scale. = FALSE)
head(pc_yield_precovid)

pc_yield_covid = prcomp(yd_curves[234:nrow(yd_curves),2:121], scale. = FALSE)
head(pc_yield_covid)

 

CALCUL DU PVE ET PVE CUMULÉ  

pc_var_precovid = pc_yield_precovid$sdev^2
PVE_precovid = pc_var_precovid / sum(pc_var_precovid)
head(PVE_precovid)

pc_var_covid = pc_yield_covid$sdev^2
PVE_covid = pc_var_covid / sum(pc_var_covid)
head(PVE_covid)

par(mfrow = c(2,2))
barplot(PVE_precovid[1:3], ylim = c(0,1), names.arg = paste('PC', 1:3), xlab = 'Components', main = 'PVE - Période pré-COVID', ylab = 'PVE')
barplot(cumsum(PVE_precovid[1:3]), ylim = c(0,1), names.arg = 1:3, xlab = 'Number of components', main = 'Cumulative PVE - Période pré-COVID', ylab = 'PVE')
barplot(PVE_covid[1:3], ylim = c(0,1), names.arg = paste('PC', 1:3), xlab = 'Components', main = 'PVE - Période COVID', ylab = 'PVE')
barplot(cumsum(PVE_covid[1:3]), ylim = c(0,1), names.arg = 1:3, xlab = 'Number of components', main = 'Cumulative PVE - Période COVID', ylab = 'PVE')

 

Dans les deux périodes, la première composante PC1 explique plus de 80% de la variance des données. Le reste de la variance est expliqué par les composantes PC2 et PC3. Dans ce cas, il suffit d’utiliser la première composante pour expliquer la majeure partie des données.  

 

Période pré-COVID  

loadings = pc_yield_precovid$rotation[,1:3]
M = ncol(loadings)

par(mfrow = c(3,1))
for (i in 1:M) {
  barplot(loadings[,i], ylim = c(-0.4,0.4), main = paste("Principal component ", i))
  abline(h=0)
}

 

Période COVID  

loadings_covid = pc_yield_covid$rotation[,1:3]
M = ncol(loadings)

par(mfrow = c(3,1))
for (i in 1:M) {
  barplot(loadings_covid[,i], ylim = c(-0.4,0.4), main = paste("Principal component ", i))
  abline(h=0)
}

   

Période pré-COVID  

Pour la composante 1, l’intervention de la banque centrale produit un effet similaire, peu importe l’échéance. Pour la composante 2, l’intervention de la banque centrale produit des effets différents selon que l’échéance soit à court et moyen terme, ou bien à long terme. Pour la composante 3, l’intervention a un effet différent, suivant l’échéance à CT, MT ou LT.  

Période COVID   Pour la composante 1, la tendance est similaire à la composante 1 de la période pré-COVID. Pour les composantes 2 et 3, les tendances sont inverses à ce qui est observé pendant la période pré-COVID.

 

Tâche C. (2.5 points SUPPLÉMENTAIRES)

Cette tâche est OPTIONNELLE

Pour chaque période et chacune des premières trois composantes principales, créer des graphiques des chocs. C’est-à-dire, des graphiques montrant la courbe des rentabilités moyennes à chaque échéance (la courbe affichée dans le point A), aussi que la courbe des rentabilités moyennes plus deux fois l’écart-type de la composante multiplié par le loading de la composante (courbe positivement choquée) et la courbe des rentabilités moyennes moins deux fois l’écart-type de la composante multiplié par le loading de la composante (courbe négativement choquée).

Ces graphiques sont utiles pour bien interpreter l’effet de chaque composante principale sur la courbe des rentabilités moyennes.  

# PERIODE PRECOVID

# CHOCS POSITIFS

# COMPOSANTE 1

loading_comp_pos_1 = pc_yield_precovid$rotation[,1]

data_courbe_precovid_comp_pos_1 = matrix(0,120,1)

mean_col_pos_precovid = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_pos_1[i] = mean_col_pos_precovid[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_1[i]
}

# COMPOSANTE 2

loading_comp_pos_2 = pc_yield_precovid$rotation[,2]

data_courbe_precovid_comp_pos_2 = matrix(0,120,1)

mean_col_pos_precovid_2 = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_pos_2[i] = mean_col_pos_precovid_2[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_2[i]
}

# COMPOSANTE 3

loading_comp_pos_3 = pc_yield_precovid$rotation[,3]

data_courbe_precovid_comp_pos_3 = matrix(0,120,1)

mean_col_pos_precovid_3 = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_pos_3[i] = mean_col_pos_precovid_3[i] + 2*pc_yield_precovid$sdev[i] * loading_comp_pos_3[i]
}

# CHOCS NEGATIFS

# COMPOSANTE 1

loading_comp_neg_1 = pc_yield_precovid$rotation[,1]

data_courbe_precovid_comp_neg_1 = matrix(0,120,1)

mean_col_neg_precovid = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_neg_1[i] = mean_col_neg_precovid[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_1[i]
}

# COMPOSANTE 2

loading_comp_neg_2 = pc_yield_precovid$rotation[,2]

data_courbe_precovid_comp_neg_2 = matrix(0,120,1)

mean_col_neg_precovid_2 = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_neg_2[i] = mean_col_neg_precovid_2[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_2[i]
}

# COMPOSANTE 3

loading_comp_neg_3 = pc_yield_precovid$rotation[,3]

data_courbe_precovid_comp_neg_3 = matrix(0,120,1)

mean_col_neg_precovid_3 = apply(yd_curves[1:233,2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_precovid_comp_neg_3[i] = mean_col_neg_precovid_3[i] - 2*pc_yield_precovid$sdev[i] * loading_comp_neg_3[i]
}
# PERIODE COVID

# CHOCS POSITIFS

# COMPOSANTE 1

loading_comp_pos_1 = pc_yield_covid$rotation[,1]

data_courbe_covid_comp_pos_1 = matrix(0,120,1)

mean_col_pos_covid = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_pos_1[i] = mean_col_pos_covid[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_1[i]
}

# COMPOSANTE 2

loading_comp_pos_2 = pc_yield_covid$rotation[,2]

data_courbe_covid_comp_pos_2 = matrix(0,120,1)

mean_col_pos_covid_2 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_pos_2[i] = mean_col_pos_covid_2[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_2[i]
}

# COMPOSANTE 3

loading_comp_pos_3 = pc_yield_covid$rotation[,3]

data_courbe_covid_comp_pos_3 = matrix(0,120,1)

mean_col_pos_covid_3 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_pos_3[i] = mean_col_pos_covid_3[i] + 2*pc_yield_covid$sdev[i] * loading_comp_pos_3[i]
}

# CHOCS NEGATIFS

# COMPOSANTE 1

loading_comp_neg_1 = pc_yield_covid$rotation[,1]

data_courbe_covid_comp_neg_1 = matrix(0,120,1)

mean_col_neg_covid = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_neg_1[i] = mean_col_neg_covid[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_1[i]
}

# COMPOSANTE 2

loading_comp_neg_2 = pc_yield_covid$rotation[,2]

data_courbe_covid_comp_neg_2 = matrix(0,120,1)

mean_col_neg_covid_2 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_neg_2[i] = mean_col_neg_covid_2[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_2[i]
}

# COMPOSANTE 3

loading_comp_neg_3 = pc_yield_covid$rotation[,3]

data_courbe_covid_comp_neg_3 = matrix(0,120,1)

mean_col_neg_covid_3 = apply(yd_curves[234:nrow(yd_curves),2:121], FUN = mean, 2)

for(i in 1:120) {
  data_courbe_covid_comp_neg_3[i] = mean_col_neg_covid_3[i] - 2*pc_yield_covid$sdev[i] * loading_comp_neg_3[i]
}

data_all_precovid = data.frame(mean_col_pos_precovid, data_courbe_precovid_comp_pos_1, data_courbe_precovid_comp_pos_2, data_courbe_precovid_comp_pos_3, data_courbe_precovid_comp_neg_1, data_courbe_precovid_comp_neg_2, data_courbe_precovid_comp_neg_3)

data_all_covid = data.frame(mean_col_pos_covid, data_courbe_covid_comp_pos_1, data_courbe_covid_comp_pos_2, data_courbe_covid_comp_pos_3, data_courbe_covid_comp_neg_1, data_courbe_covid_comp_neg_2, data_courbe_covid_comp_neg_3)

x = seq(3,360,3)

   

POUR LA PERIODE PRECOVID

ggplot(data_all_precovid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
  geom_line(aes(y = data_courbe_precovid_comp_pos_1, col = 'red')) +
  geom_line(aes(y = data_courbe_precovid_comp_neg_1, col = 'blue')) +
  theme_minimal() +
  labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 1") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

ggplot(data_all_precovid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
  geom_line(aes(y = data_courbe_precovid_comp_pos_2, col = 'red')) +
  geom_line(aes(y = data_courbe_precovid_comp_neg_2, col = 'blue')) +
  theme_minimal() +
    labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 2") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

ggplot(data_all_precovid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_precovid, col = 'green')) +
  geom_line(aes(y = data_courbe_precovid_comp_pos_3, col = 'red')) +
  geom_line(aes(y = data_courbe_precovid_comp_neg_3, col = 'blue')) +
  theme_minimal() +
    labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 3") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

 

Pour la période pré-COVID, on constate que pour la composante 1, quand il y a un choc positif (bonne nouvelle), les taux moyens à court terme augmentent, alors que lorsqu’il y a un choc négatif (mauvaise nouvelle), les taux moyens à court terme diminuent. On constate également que l’impact des chocs est seulement sur le court terme. Il semblerait qu’après un certain temps, l’effet des chocs positif comme négatif s’estompe.

Pour la composante 2, l’effet à court terme est similaire à celui de la composante 1, mais l’effet du choc négatif se prolonge sur le moyen terme.

Pour la composante 3, nous observons l’inverse des situations des deux autres composantes : suite à un choc positif, les taux moyens à court terme diminuent fortement, tandis que ces mêmes taux augmentent suite à un choc négatif. On peut en déduire que cette composante ne permet pas d’expliquer l’effet de la politique de la Banque du Canada.

 

POUR LA PERIODE COVID  

Voici les graphiques pour la période COVID :  

ggplot(data_all_covid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
  geom_line(aes(y = data_courbe_covid_comp_pos_1, col = 'red')) +
  geom_line(aes(y = data_courbe_covid_comp_neg_1, col = 'blue')) +
  theme_minimal() +
  labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 1") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

ggplot(data_all_covid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
  geom_line(aes(y = data_courbe_covid_comp_pos_2, col = 'red')) +
  geom_line(aes(y = data_courbe_covid_comp_neg_2, col = 'blue')) +
  theme_minimal() +
    labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 2") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

ggplot(data_all_covid, aes(x = x)) +
  geom_line(aes(y = mean_col_pos_covid, col = 'green')) +
  geom_line(aes(y = data_courbe_covid_comp_pos_3, col = 'red')) +
  geom_line(aes(y = data_courbe_covid_comp_neg_3, col = 'blue')) +
  theme_minimal() +
    labs(x = "Échéance",
       y = "Average yield",
       col = "Situation") +
  scale_color_discrete(labels = c("Choc positif", "Rentabilité moyenne", "Choc négatif")) +
  ggtitle("Taux moyens de rentabilité en fonction \n de leur échéance, suivant un choc positif ou négatif - COMPOSANTE 3") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

 

Pour les données en période de crise, pour la composante 1, lorsqu’il y a un choc positif, les taux moyens à CT diminuent alors que lors d’un choc négatif, les taux moyens à CT augmentent. Les chocs ne semblent pas impacter les taux à LT.

Pour la composante 2, on constate l’inverse de la composante 1.

Pour la composante 3, l’effet est similaire à la composante 1, mais est davantage prononcé et plus durable.  

Tâche D. (3 points)

Comparer les premières trois composantes principales obtenues pour les deux périodes (avant et au cours de la première vague de COVID-19). Quels ont été les effets de l’intervention de la Banque du Canada sur la structure par termes des taux d’intérêt?

 

loadings = as.data.frame(loadings)
loadings_covid = as.data.frame(loadings_covid)
loadings$x = x
loadings_covid$x = x

loadings_all = loadings %>%
  full_join(., loadings_covid, by = c('x' = 'x'))

colnames(loadings_all) = c("PC1_precovid", "PC2_precovid", "PC3_precovid", "x", "PC1_covid", "PC2_covid", "PC3_covid")

pc_1 = ggplot(loadings_all, aes(x = x)) +
  geom_line(aes(y = PC1_precovid, col = "red")) +
  geom_line(aes(y = PC1_covid, col = "blue")) +
    theme_minimal() +
    labs(x = "Échéance",
       y = " ",
       col = "Situation") +
  scale_color_discrete(labels = c("PC1 pré COVID", "PC1 COVID")) +
  ggtitle("COMPOSANTE 1") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

pc_2 = ggplot(loadings_all, aes(x = x)) +
  geom_line(aes(y = PC2_precovid, col = "red")) +
  geom_line(aes(y = PC2_covid, col = "blue")) +
    theme_minimal() +
    labs(x = "Échéance",
       y = " ",
       col = "Situation") +
  scale_color_discrete(labels = c("PC1 pré COVID", "PC1 COVID")) +
  ggtitle("COMPOSANTE 2") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

pc_3 = ggplot(loadings_all, aes(x = x)) +
  geom_line(aes(y = PC3_precovid, col = "red")) +
  geom_line(aes(y = PC3_covid, col = "blue")) +
    theme_minimal() +
    labs(x = "Échéance",
       y = " ",
       col = "Situation") +
  scale_color_discrete(labels = c("PC3 pré COVID", "PC3 COVID")) +
  ggtitle("COMPOSANTE 3") +
  theme(plot.title = element_text(family = 'Helvetica', face = 'bold', hjust = 0.5, size = 12),
        axis.title.x = element_text(size = 10),
        axis.title.y = element_text(size = 10))

ggarrange(pc_1, pc_2, pc_3, nrow = 3, ncol = 1)

   

Pour chaque composante, on observe que lorsque la tendance est à la hausse pour l’une des périodes, la tendance est inverse dans l’autre période. Comme vu précédemment à la tâche A, l’effet de l’intervention de la Banque du Canada sur la structure à terme produit une baisse des taux moyens à court terme plus rapide que celle des taux moyens à long terme. Ainsi, après l’intervention en période COVID, la structure à terme est croissante.